home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SORTING.SWG / 0014_Pointer Sort.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  4KB  |  149 lines
  1. {
  2. REYNIR STEFANSSON
  3.  
  4. Some time ago I wangled myself into a beta testing team For a floppy
  5. disk catalogger called FlopiCat. This is a rather BASIC (in more than one
  6. way) Program, but works well enough.
  7.  
  8. The built-in sorting routine was a bit quacked, so I wrote my own
  9. external sorter, which is both more versatile and faster (by far) than the
  10. internal one.
  11.  
  12.      Here it is, in Case someone can use the idea (and code):
  13. }
  14.  
  15. Program FlopiSrt; { Sorts FlopiCat.Dat. }
  16.  
  17. Const
  18.   Maximum = 6000; { I don't need that many meself... }
  19.   FName   : String[12] = 'Flopicat.Dat';
  20.  
  21. Type
  22.   fEntry = Record
  23.     n : Array[1..4] of Char;
  24.     i : Array[1..35] of Char;
  25.     d : Array[1..39] of Char;
  26.   end;
  27.  
  28.   En1 = Array[1..78] of Char;
  29.   En2 = Record
  30.     n : Array[1..4] of Char;
  31.     f : Array[1..9] of Char;
  32.     e : Array[1..3] of Char;
  33.     z : Array[1..8] of Char;
  34.     t : Array[1..15] of Char;
  35.     d : Array[1..39] of Char;
  36.   end;
  37.  
  38.   En3 = Record
  39.     f, d : Array[1..39] of Char;
  40.   end;
  41.  
  42.   pEntry = ^fEntry;
  43.  
  44. Var
  45.   Entry        : Array [1..Maximum] of pEntry;
  46.   fc           : File of fEntry;
  47.   Rev          : Boolean;
  48.   LoMem        : Pointer;
  49.   i,
  50.   NumOfEntries : Integer;
  51.   nfd          : Char;
  52.   s            : String;
  53.  
  54. Function ToSwap(i, j : Integer) : Boolean;
  55. Var
  56.   Swop : Boolean;
  57. begin
  58.   Swop := False;
  59.   Case nfd OF
  60.     { Sorting by disk number: }
  61.     'N' : if Entry[i]^.n > Entry[j]^.n then
  62.             Swop := True;
  63.     { Sorting by File information: }
  64.     'I' : if Entry[i]^.i > Entry[j]^.i then
  65.             Swop := True;
  66.     { Sorting by description: }
  67.     'D' : if Entry[i]^.d > Entry[j]^.d then
  68.             Swop := True;
  69.     { Sorting by all the String: }
  70.     'A' : if En1(Entry[i]^) > En1(Entry[j]^) then
  71.             Swop := True;
  72.     { Sorting by File name only: }
  73.     'F' : if En2(Entry[i]^).f > En2(Entry[j]^).f then
  74.             Swop := True;
  75.     { Sorting by File extension only: }
  76.     'E' : if En2(Entry[i]^).e > En2(Entry[j]^).e then
  77.             Swop := True;
  78.     { Sorting by File size: }
  79.     'Z' : if En2(Entry[i]^).z > En2(Entry[j]^).z then
  80.             Swop := True;
  81.     { Sorting by date/time stamp: }
  82.     'T' : if En2(Entry[i]^).t > En2(Entry[j]^).t then
  83.             Swop := True;
  84.     { Sorting by disk number/File info block: }
  85.     'B' : if En3(Entry[i]^).f > En3(Entry[j]^).f then
  86.             Swop := True;
  87.   end;
  88.   ToSwap := Swop xor Rev;
  89. end;
  90.  
  91. { if I remember correctly, I settled on using shaker/shuttle sort. }
  92. Procedure SortIt;
  93. Var
  94.   i, j,
  95.   pb, pf,
  96.   pp, pt : Integer;
  97.   t      : pEntry;
  98.  
  99.   Procedure SwapIt(i, j : Integer);
  100.   begin
  101.     t := Entry[i];
  102.     Entry[i] := Entry[j];
  103.     Entry[j] := t;
  104.   end;
  105.  
  106. begin
  107.   Write('0    entries processed.');
  108.   i  := 0;
  109.   pt := 2;
  110.   pb := NumOfEntries;
  111.   pf := 0;
  112.   Repeat
  113.     pp := pt;
  114.     Repeat
  115.       if ToSwap(pp - 1, pp) then
  116.       begin
  117.         SwapIt(pp - 1, pp);
  118.         pf := pp;
  119.       end;
  120.       Inc(pp);
  121.     Until pp > pb;
  122.  
  123.     pb := pf - 1;
  124.     j  := i;
  125.     i  := NumOfEntries - (pb - pt + 2);
  126.     if (i MOD 10) < (j MOD 10) then
  127.       Write(#13, i);
  128.     if pb < pt then
  129.       Exit;
  130.     pp := pb;
  131.  
  132.     Repeat
  133.       if ToSwap(pp - 1, pp) then
  134.       begin
  135.         SwapIt(pp - 1, pp);
  136.         pf := pp;
  137.       end;
  138.       Dec(pp);
  139.     Until pp < pt;
  140.  
  141.     pt := pf + 1;
  142.     j  := i;
  143.     i  := NumOfEntries - (pb - pt + 2);
  144.     if (i MOD 10) < (j MOD 10) then
  145.       Write(#13, i);
  146.   Until pb < pt;
  147. end;
  148.  
  149.